VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFileFunctions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Function FileDataToInsert(Optional strFile As String, Optional lngFailureReason As Long) As Boolean

    Dim strPathName As String
    Dim strExpectedFileName As String
    Dim strFilename As String
    Static lngFileCount As Long
    
    On Error GoTo FileDataToInsert_Fix
    
    If LocationFolderExists Then
      strPathName = objReg.AsciiFileLocation
    Else
      lngFailureReason = -11
      HandleError 0, "FILE_ERROR", "FileDataToInsert", "Response file location unknown.", 0
      FileDataToInsert = False
      Exit Function
    End If
    
    If Right(strPathName, 1) <> "\" Then
        strPathName = strPathName & "\"
    End If
    
''    If Dir$(strPathName & "IRP3CRP.R*") <> "" Then
''            strExpectedFileName = GetNextFileName
''            'strFileName = Dir$(strPathName & strExpectedFileName)
''            strFileName = Dir$(strPathName & "IRP3CRP.R*")
''            If strFileName <> "" Then
''                If strFileName = strExpectedFileName Then
''                    strFile = strPathName & strFileName
''                    lngFileCount = lngFileCount + 1
''                    lngFailureReason = lngFileCount
''                    FileDataToInsert = True
''                Else
''                    strFile = ""
''                    HandleError 0, "FILE_ERROR", "FileDataToInsert", "Current File: " & strFileName & " .Expected file: " & strExpectedFileName, 0
''                    lngFailureReason = FILE_ERROR
''                    FileDataToInsert = False
''                End If
''            Else
''                strFile = ""
''                HandleError 0, "FILE_ERROR", "FileDataToInsert", "Expected file: " & strExpectedFileName & " . Similar files exist but not the expected file. Response files are out of sequence.", 0
''                lngFailureReason = FILE_ERROR
''                FileDataToInsert = False
''            End If
''    Else
''        strFile = ""
''        lngFailureReason = NO_DATA_TO_INSERT
''        FileDataToInsert = False
''    End If
    
    'barb: watch this
    Load frmShanksOpt
    frmShanksOpt.flbRecFiles.Path = strPathName
    frmShanksOpt.flbRecFiles.Refresh
    
    If Not CancelResponseFileExists(strFilename) Then
        lngFailureReason = NO_DATA_TO_INSERT
        FileDataToInsert = False
    Else
        strFile = strPathName & strFilename
        lngFileCount = lngFileCount + 1
        lngFailureReason = lngFileCount
        FileDataToInsert = True
    End If

    Unload frmShanksOpt
    Exit Function
    
FileDataToInsert_Fix:
    HandleError Err.Number, Err.Description, "FileDataToExtract"
    strFile = ""
    lngFailureReason = FILE_ERROR
    FileDataToInsert = False
End Function
Private Function CancelResponseFileExists(strFilename As String) As Boolean

    Dim i As Integer
    Dim strExistingFile As String
    Dim strExpectedFileName As String

    Load frmShanksOpt
    frmShanksOpt.flbRecFiles.Pattern = "IRP3CRP.R*"
    frmShanksOpt.flbRecFiles.Refresh
        
    If frmShanksOpt.flbRecFiles.ListCount > 0 Then
        For i = 0 To frmShanksOpt.flbRecFiles.ListCount - 1
            strExistingFile = frmShanksOpt.flbRecFiles.List(i)
            strExpectedFileName = GetNextFileName()
            'barb: watch this - seq was out last time changed from 5 to 6
            If strExistingFile = strExpectedFileName Then
                strFilename = strExistingFile
                CancelResponseFileExists = True
                Exit Function
            End If
        Next i
        CancelResponseFileExists = False
    Else
        CancelResponseFileExists = False
    End If

End Function
Private Function GetNextFileName() As String

    Dim strNextFileName As String
    
    On Error GoTo GetNextFileName_Fix

    strNextFileName = "IRP3CRP.R" & GetExpectedFileSeq
    objReg.AsciiFileName = strNextFileName
    GetNextFileName = strNextFileName

    Exit Function
GetNextFileName_Fix:
    GetNextFileName = ""
    HandleError Err.Number, Err.Description, "GetNextFileName"
End Function
Public Function GetExpectedFileSeq() As String

    Dim strSeq As String
    Dim strFillString As String
    Dim strSql As String
    Dim lngValue As Long
    Dim rsLastValue As ADODB.Recordset
    
    On Error GoTo GetExpectedFileSeqFix
    
    strSql = "Select LAST_VALUE from DIR_SEQUENCES where SEQ_NAME = 'DIR_IRP3CRP_SEQ'"
    Set rsLastValue = objAdoConn.OpenRecordset(strSql)
    If rsLastValue.RecordCount > 0 Then
        If Not IsNull(rsLastValue!LAST_VALUE) Then
            If rsLastValue!LAST_VALUE <> 0 Then
                If rsLastValue!LAST_VALUE <> 999999 Then
                    lngValue = rsLastValue!LAST_VALUE + 1
                    strFillString = String(6, "0")
                    strSeq = Format(CStr(lngValue), strFillString)
                Else
                    strSeq = "000001"
                End If
            Else
                strSeq = "000001"
            End If
        Else
            strSeq = "000001"
        End If
    Else
        strSeq = "000001"
    End If

    GetExpectedFileSeq = strSeq

    Exit Function
GetExpectedFileSeqFix:
  HandleError Err.Number, Err.Description, "GetExpectedFileSeq"
  GetExpectedFileSeq = ""
End Function

Public Function UpdateLastFileSeq(strLastUsedName As String) As Boolean

    Dim strLastDbSeq As String
    Dim strLastDbName As String
    Dim strSql As String
    Dim lngRecordsAffected As Long

    On Error GoTo UpdateLastFileSeqFix

    strLastDbSeq = GetExpectedFileSeq
    strLastDbName = "IRP3CRP.R" & strLastDbSeq
    If strLastUsedName = strLastDbName Then
        strSql = "Update DIR_SEQUENCES set LAST_VALUE = " & CDbl(strLastDbSeq) & " where SEQ_NAME = 'DIR_IRP3CRP_SEQ'"
        lngRecordsAffected = objAdoConn.ExecuteQuery(strSql)
        If lngRecordsAffected = 1 Then
            UpdateLastFileSeq = True
        Else
            HandleError Err.Number, Err.Description, "UpdateLastFileSeq", "Error executing: " & strSql
            UpdateLastFileSeq = False
        End If
    Else
        HandleError Err.Number, Err.Description, "UpdateLastFileSeq"
        UpdateLastFileSeq = False
    End If
    
    Exit Function
    
UpdateLastFileSeqFix:
    UpdateLastFileSeq = False
    HandleError Err.Number, Err.Description, "UpdateLastFileSeq"
End Function

'Public Function ReadFile(PathFileName As String, _
                        strFixedStringHeader As String, _
                        strFooter As String, _
                        arRecords() As Variant) As Boolean
Public Function ReadFile(PathFileName As String, _
                        strFixedStringHeader As String, _
                        strFooter As String, _
                        colRecords As Collection) As Boolean

Dim strFileString As String
Dim FNumber As Long
Dim strSingleRecord As String
Static FileLineCount As Long
'Dim varArrayClear() As Variant


On Error GoTo Readfile_Fix

Set colRecords = New Collection
FileLineCount = 0


'GET NEXT FILENUMBER
FNumber = FreeFile

'READ FILE
Open PathFileName For Input As FNumber
     'READ HEADER FROM FILE
    Line Input #FNumber, strFileString
    'PROCESS FILE DATA
    If GetHeader(strFileString, strFixedStringHeader) Then

        Do While Not EOF(FNumber)
            'READ A LINE FROM FILE
            Line Input #FNumber, strFileString
            If strFileString <> "" Then
                'PROCESS FILE DATA
                If GetRecord(strFileString, strSingleRecord, FileLineCount + 1) Then
                    FileLineCount = FileLineCount + 1
                    colRecords.Add strSingleRecord, CStr(FileLineCount)
                Else
                  Close #FNumber
                  ReadFile = False
                  Exit Function
                End If
            End If
        Loop
    Else
        Close #FNumber
        If HeaderFileFlag Then
          If Not ProcessHeaderFile(strFixedStringHeader) Then
            HeaderFileFlag = False
            ProcessErrorFile Right(strFixedStringHeader, 2)
          End If
        Else
          ProcessErrorFile Right(strFixedStringHeader, 2)
        End If
        ReadFile = False
        Exit Function
    End If
Close #FNumber
'strFooter = arRecords(UBound(arRecords))
strFooter = colRecords(CStr(FileLineCount))
'ReDim Preserve arRecords(UBound(arRecords) - 1)
colRecords.Remove (FileLineCount)
FileLineCount = FileLineCount - 1

ReadFile = True

Exit Function

Readfile_Fix:
    ReadFile = False
    HandleError Err.Number, Err.Description, "ReadFile"
End Function
Private Function GetHeader(FileStmt As String, strFixedHeader As String) As Boolean

Dim intPos As Integer
Dim iColCount As Integer

On Error GoTo GetHeaderFix

    iColCount = 0
    'CHECK THAT THIS IS THE HEADER
    'new: no columns or quotes in file string
    If Mid(FileStmt, 1, 1) <> "H" Then
        MsgBox "HEADER ERROR"
        GetHeader = False
        Exit Function
    End If
    
    strFixedHeader = FileStmt
    
    'these header strings have length of 303 - all nulls at end
    strFixedHeader = RTrim(strFixedHeader)
    If Len(strFixedHeader) <> 79 Then
        GetHeader = False
    Else
        If Right(strFixedHeader, 2) <> "01" Then
            GetHeader = False
        Else
            If ValidateHeader(strFixedHeader) Then
                GetHeader = True
            Else
                GetHeader = False
            End If
        End If
    End If
    
    Exit Function

GetHeaderFix:
    GetHeader = False
    HandleError Err.Number, Err.Description, "GetHeader"
End Function

Private Function GetFooter(strFileStmt As String, strFooter As String) As Boolean

Dim intPos As Integer
Dim iColCount As Integer

On Error GoTo GetFooter_Fix

If Mid(strFileStmt, 1, 1) <> "T" Then
    GetFooter = False
    Exit Function
Else
    GetFooter = True
End If


strFooter = strFileStmt

'these footers also have length of 303 all null at end
strFooter = RTrim(strFooter)
'If Len(strFooter) <> 9 Then
'    GetFooter = False
'Else
'    GetFooter = True
'End If

Exit Function

GetFooter_Fix:
    GetFooter = False
    HandleError Err.Number, Err.Description, "GetFooter"
End Function

Private Function GetRecord(FileStmt As String, strFixedRecord As String, lngLineCount As Long) As Boolean

Dim intPos As Integer
Dim iColCount As Integer

Dim arLastRecord()

On Error GoTo GetRecordFix
    
    If Mid(FileStmt, 1, 1) <> "R" Then
        If Mid(FileStmt, 1, 1) = "T" Then
            If GetFooter(FileStmt, strFixedRecord) Then
                GetRecord = True
                Exit Function
            Else
                GoTo GetRecordFix
            End If
        Else
            GoTo GetRecordFix
        End If
        GoTo GetRecordFix
    End If
    
    strFixedRecord = FileStmt

    If Len(strFixedRecord) = 303 Then   'if approved'1315 including chr(13)
        GetRecord = True
    Else
        If Len(strFixedRecord) = 69 Then 'if declined
            GetRecord = True
        Else
            GetRecord = False
        End If
    End If
Exit Function

GetRecordFix:
    GetRecord = False
    HandleError Err.Number, Err.Description, "GetRecord", , lngLineCount
End Function

Public Function FileCleanUp(strFilePathName As String) As Boolean
'   set the last successful filename in database
'   rename or move last successful file
    
    On Error GoTo FileCleanUp_Fix
    
    Dim strSuffix As String
    Dim strNewFileName As String
    Dim strPath As String
    Dim strOldFileName As String
    Dim strArchivePath As String
    
    'strpath includes the last "\"
    strPath = Left(strFilePathName, Len(strFilePathName) - 15)
    strArchivePath = objReg.ArchiveFileLocation
    strOldFileName = Right(strFilePathName, 15)
    strSuffix = Right(strOldFileName, 6)
    strNewFileName = Left(strOldFileName, Len(strOldFileName) - 7) & "A" & strSuffix
    
    'objReg.AsciiFileName = strOldFileName
    
    'Name strPath & strOldFileName As strPath & strNewFileName '- moves And renames
    Name strPath & strOldFileName As strArchivePath & strNewFileName '- moves And renames
    
    If UpdateLastFileSeq(strOldFileName) Then
        FileCleanUp = True
    End If
    
    Exit Function
FileCleanUp_Fix:
    FileCleanUp = False
    HandleError Err.Number, Err.Description, "FileCleanUp"
End Function
Private Sub ProcessErrorFile(strErrCode As String)

    Dim strSuffix As String
    Dim strNewFileName As String
    Dim strOldFileName As String
    Dim strPath As String
    Dim strErrorPath As String

    On Error GoTo ProcessErrorFileFix
    
    'if file error as per sars pg 356 no(11)
    'If strErrCode <> "01" Then
    If Not HeaderFileFlag Then
        strPath = objReg.AsciiFileLocation
        strErrorPath = objReg.ErrorFileLocation
        strOldFileName = objReg.AsciiFileName
        strSuffix = Right(strOldFileName, 6)
        strNewFileName = Left(strOldFileName, Len(strOldFileName) - 7) & "E" & strSuffix
        'Name strPath & "\" & strOldFileName As strPath & "\" & strNewFileName '- moves And renames
        Name strPath & strOldFileName As strErrorPath & strNewFileName   '- moves And renames
    End If

    Exit Sub

ProcessErrorFileFix:
  HandleError Err.Number, Err.Description, "ProcessErrorFile"
End Sub
Private Function LocationFolderExists() As Boolean
'   Check that the directory to search for incoming files from sars
'   exists, else pop up form for new dir or create one

    Dim strCurrentRegFolder As String

    '\\LIB_NT_01\USERS\BJM0509\Temp

    On Error GoTo LocationFolderExistsFix

    strCurrentRegFolder = objReg.AsciiFileLocation

    If strCurrentRegFolder = "" Then
        frmDirType.Show vbModal
        If Not frmDirType.blnCancel Then
            strCurrentRegFolder = frmDirType.strDir
        Else
            LocationFolderExists = False
            Exit Function
        End If
    End If
    
        If ValidLocationFolder(strCurrentRegFolder) Then
            objReg.AsciiFileLocation = strCurrentRegFolder
            LocationFolderExists = True
        Else
            LocationFolderExists = False
        End If
    
    Exit Function
LocationFolderExistsFix:
    LocationFolderExists = False
    HandleError Err.Number, Err.Description, "LocationFolderExists"
End Function
Private Function ValidLocationFolder(strFolder As String) As Boolean

  On Error GoTo ValidLocationFolderFix

    'CHECK IF DIR EXISTS, ELSE CREATE?
    If Dir(strFolder, vbDirectory) = "" Then
        frmDirType.strDir = strFolder
        frmDirType.Show vbModal
        If frmDirType.blnCancel Then
            ValidLocationFolder = False
            Exit Function
        Else
          strFolder = frmDirType.strDir
        End If
    Else
        If Right(strFolder, 1) <> "\" Then
            strFolder = strFolder & "\"
        End If
    End If
    
    ValidLocationFolder = True
    
    Exit Function
ValidLocationFolderFix:
    ValidLocationFolder = False
    HandleError Err.Number, Err.Description, "ValidLocationFolder"
End Function

Private Function ValidateHeader(strHead) As Boolean

  Dim strFileSysId As String
  Dim strFileTestData As String
  Dim strDbSysId As String
  Dim strDbTestData As String
  Dim rsSystemParameters As ADODB.Recordset
  Dim strSql As String
  Dim strPreviousReqFileName As String
  Dim lngRecordsAffected As Long
  Dim rsTemp  As ADODB.Recordset



  On Error GoTo ValidateHeaderFix

'check for header file
'barb: this is because of the cancel file name length - sras don't care - we'll just add the I back in
  strPreviousReqFileName = "I" & Mid(strHead, 64, 14)
  If Trim(strPreviousReqFileName) <> "" Then
    If Trim(strPreviousReqFileName) <> "I" Then
        strHead = Trim(strPreviousReqFileName)
        HeaderFileFlag = True
        ValidateHeader = False
        Exit Function
    End If
  End If

    strSql = "Select VAR_VALUE from DIR_PARAMETERS where CODE = 'ISP0901'"
    Set rsSystemParameters = objAdoConn.OpenRecordset(strSql)
    If rsSystemParameters.RecordCount > 0 Then
        If Not IsNull(rsSystemParameters!VAR_VALUE) Then
            strDbSysId = rsSystemParameters!VAR_VALUE
        Else
            HandleError "0", "No value for ISP0901 in DIR_PARAMETERS.", "ValidateHeader"
            ValidateHeader = False
            Exit Function
        End If
    Else
        HandleError "0", "No value for ISP0901 in DIR_PARAMETERS.", "ValidateHeader"
        ValidateHeader = False
        Exit Function
    End If
    
    strSql = "Select VAR_VALUE from DIR_PARAMETERS where CODE = 'TEST_DATA'"
    Set rsSystemParameters = objAdoConn.OpenRecordset(strSql)
    If rsSystemParameters.RecordCount > 0 Then
        If Not IsNull(rsSystemParameters!VAR_VALUE) Then
            strDbTestData = rsSystemParameters!VAR_VALUE
            If Len(strDbTestData) <> 1 Then
                HandleError "0", "No value for TEST_DATA in DIR_PARAMETERS.", "ValidateHeader"
                ValidateHeader = False
                Exit Function
            End If
        Else
            HandleError "0", "No value for TEST_DATA in DIR_PARAMETERS.", "ValidateHeader"
            ValidateHeader = False
            Exit Function
        End If
    Else
        MsgBox "System Parameter Error"
        ValidateHeader = False
        Exit Function
    End If
    
    strFileSysId = Mid(strHead, 20, 8)
    strFileTestData = Mid(strHead, 18, 1)
    
    If strFileSysId = strDbSysId Then
      If strFileTestData = strDbTestData Then
        ValidateHeader = True
      Else
        HandleError Err.Number, Err.Description, "ValidateHeader", "Incorrect Test Data Identifier.Expecting test data:" & strDbTestData
        ValidateHeader = False
      End If
    Else
      HandleError Err.Number, Err.Description, "ValidateHeader", "Incorrect System Identifier."
      ValidateHeader = False
    End If
    Exit Function
ValidateHeaderFix:
    HandleError Err.Number, Err.Description, "ValidateHeader"
    ValidateHeader = False
End Function
Private Function ProcessHeaderFile(ResponseToFile As String) As Boolean

  Dim strSql As String
  Dim rsTemp As ADODB.Recordset
  Dim lngRecordsAffected As Long

  ResponseToFile = Trim(ResponseToFile)
  If Trim(ResponseToFile) <> "" Then
    strSql = "Select max(REQ_SEQ_NUM) from DIR_REQUEST"
    strSql = strSql & " WHERE REQ_FILE_NAME = '" & ResponseToFile & "'"
    Set rsTemp = objAdoConn.OpenRecordset(strSql)
    If rsTemp.RecordCount > 0 Then
      If Not IsNull(rsTemp(0)) Then
        strSql = "Update DIR_REQUEST "
        strSql = strSql & " set process_status_date = GETDATE(),"
        strSql = strSql & " scod_process_status = 'FA'"
        strSql = strSql & " WHERE REQ_FILE_NAME = '" & ResponseToFile & "'"
        lngRecordsAffected = objAdoConn.ExecuteQuery(strSql)
        If lngRecordsAffected > 0 Then
          'this is a header header - exit and move onto next file
            If FileCleanUp(objReg.AsciiFileLocation & objReg.AsciiFileName) Then
                ProcessHeaderFile = True
            Else
                HandleError "0", "File clean up failed for header file.", "ValidateHeader"
                ProcessHeaderFile = False
            End If
        Else
          HandleError "0", "Unable to update status for header file.", "ValidateHeader"
          ProcessHeaderFile = False
        End If
      Else
        HandleError "0", "Filename in header that doesn't exist in database", "ValidateHeader"
        ProcessHeaderFile = False
      End If
    Else
      HandleError "0", "Filename in header that doesn't exist in database", "ValidateHeader"
      ProcessHeaderFile = False
    End If
  End If


End Function
